home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / cli / gulamdoc.arc / TEXINFMT.EL < prev   
Lisp/Scheme  |  1987-11-02  |  30KB  |  861 lines
  1. ;; Convert texinfo files to info files.
  2. ;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
  3.  
  4. ;; This file is part of GNU Emacs.
  5.  
  6. ;; GNU Emacs is distributed in the hope that it will be useful,
  7. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  8. ;; accepts responsibility to anyone for the consequences of using it
  9. ;; or for whether it serves any particular purpose or works at all,
  10. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  11. ;; License for full details.
  12.  
  13. ;; Everyone is granted permission to copy, modify and redistribute
  14. ;; GNU Emacs, but only under the conditions described in the
  15. ;; GNU Emacs General Public License.   A copy of this license is
  16. ;; supposed to have been given to you along with GNU Emacs so you
  17. ;; can know your rights and responsibilities.  It should be in a
  18. ;; file named COPYING.  Among other things, the copyright notice
  19. ;; and this notice must be preserved on all copies.
  20.  
  21.  
  22. (defvar texinfo-format-syntax-table nil)
  23.  
  24. (defvar texinfo-vindex)
  25. (defvar texinfo-findex)
  26. (defvar texinfo-cindex)
  27. (defvar texinfo-pindex)
  28. (defvar texinfo-tindex)
  29. (defvar texinfo-kindex)
  30. (defvar texinfo-last-node)
  31. (defvar texinfo-node-names)
  32.  
  33. (if texinfo-format-syntax-table
  34.     nil
  35.   (setq texinfo-format-syntax-table (make-syntax-table))
  36.   (modify-syntax-entry ?\" " " texinfo-format-syntax-table)
  37.   (modify-syntax-entry ?\\ " " texinfo-format-syntax-table)
  38.   (modify-syntax-entry ?@ "\\" texinfo-format-syntax-table)
  39.   (modify-syntax-entry ?\^q "\\" texinfo-format-syntax-table)
  40.   (modify-syntax-entry ?\[ "." texinfo-format-syntax-table)
  41.   (modify-syntax-entry ?\] "." texinfo-format-syntax-table)
  42.   (modify-syntax-entry ?\( "." texinfo-format-syntax-table)
  43.   (modify-syntax-entry ?\) "." texinfo-format-syntax-table)
  44.   (modify-syntax-entry ?{ "(}" texinfo-format-syntax-table)
  45.   (modify-syntax-entry ?} "){" texinfo-format-syntax-table)
  46.   (modify-syntax-entry ?\' "." texinfo-format-syntax-table))
  47.  
  48. (defun texinfo-format-buffer (&optional notagify)
  49.   "Process the current buffer as texinfo code, into an Info file.
  50. The Info file output is generated in a buffer
  51. visiting the Info file names specified in the @setfilename command.
  52.  
  53. Non-nil argument (prefix, if interactive) means don't make tag table
  54. and don't split the file if large.  You can use Info-tagify and
  55. Info-split to do these manually."
  56.   (interactive "P")
  57.   (let ((lastmessage "Formatting Info file..."))
  58.     (message lastmessage)
  59.     (texinfo-format-buffer-1)
  60.     (if notagify
  61.     nil
  62.       (if (> (buffer-size) 30000)
  63.       (progn
  64.         (message (setq lastmessage "Making tags table for Info file..."))
  65.         (Info-tagify)))
  66.       (if (> (buffer-size) 100000)
  67.       (progn
  68.         (message (setq lastmessage "Splitting Info file..."))
  69.         (Info-split))))
  70.     (message (concat lastmessage
  71.              (if (interactive-p) "done.  Now save it." "done.")))))
  72.  
  73. (defun texinfo-format-buffer-1 ()
  74.   (let (texinfo-format-filename
  75.     texinfo-example-start
  76.     texinfo-command-start
  77.     texinfo-command-end
  78.     texinfo-command-name
  79.     texinfo-last-node
  80.     texinfo-vindex
  81.     texinfo-findex
  82.     texinfo-cindex
  83.     texinfo-pindex
  84.     texinfo-tindex
  85.     texinfo-kindex
  86.     texinfo-stack
  87.     texinfo-node-names
  88.     outfile
  89.     (fill-column fill-column)
  90.     (input-buffer (current-buffer))
  91.     (input-directory default-directory))
  92.     (save-excursion
  93.       (goto-char (point-min))
  94.       (search-forward "@setfilename")
  95.       (setq texinfo-command-end (point))
  96.       (setq outfile (texinfo-parse-line-arg)))
  97.     (find-file outfile)
  98.     (texinfo-mode)
  99.     (set-syntax-table texinfo-format-syntax-table)
  100.     (erase-buffer)
  101.     (insert-buffer-substring input-buffer)
  102.     (goto-char (point-min))
  103.     (search-forward "@setfilename")
  104.     (beginning-of-line)
  105.     (delete-region (point-min) (point))
  106.     (while (search-forward "``" nil t)
  107.       (replace-match "\""))
  108.     (goto-char (point-min))
  109.     (while (search-forward "''" nil t)
  110.       (replace-match "\""))
  111.     (goto-char (point-min))
  112.     (while (search-forward "@" nil t)
  113.       ;; If the @ is preceded by an odd number of ^Q's, do nothing,
  114.       (if (and (eq (char-after (- (point) 2)) ?\^Q)
  115.            (save-excursion
  116.          (forward-char -1)
  117.          (let ((opoint (point)))
  118.            (skip-chars-backward "\^Q")
  119.            (= (logand 1 (- opoint (point))) 1))))
  120.       nil
  121.     (if (looking-at "[@{}'` *]")
  122.         (if (= (following-char) ?*)
  123.         (delete-region (1- (point)) (1+ (point)))
  124.           (delete-char -1)
  125.           (forward-char 1))
  126.       (setq texinfo-command-start (1- (point)))
  127.       (if (= (char-syntax (following-char)) ?w)
  128.           (forward-word 1)
  129.         (forward-char 1))
  130.       (setq texinfo-command-end (point))
  131.       (setq texinfo-command-name
  132.         (intern (buffer-substring (1+ texinfo-command-start)
  133.                       texinfo-command-end)))
  134.       (let ((cmd (get texinfo-command-name 'texinfo-format)))
  135.         (if cmd (funcall cmd)
  136.           (texinfo-unsupported))))))
  137.     (cond (texinfo-stack
  138.        (goto-char (nth 2 (car texinfo-stack)))
  139.        (error "Unterminated @%s" (car (car texinfo-stack)))))
  140.     (goto-char (point-min))
  141.     (while (search-forward "\^q" nil t)
  142.       (delete-char -1)
  143.       (forward-char 1))
  144.     (goto-char (point-min))
  145.     (list outfile
  146.       texinfo-vindex texinfo-findex texinfo-cindex
  147.       texinfo-pindex texinfo-tindex texinfo-kindex)))
  148.  
  149. (put 'begin 'texinfo-format 'texinfo-format-begin)
  150. (defun texinfo-format-begin ()
  151.   (texinfo-format-begin-end 'texinfo-format))
  152.  
  153. (put 'begin 'texinfo-format 'texinfo-format-begin)
  154. (defun texinfo-format-begin ()
  155.   (texinfo-format-begin-end 'texinfo-format))
  156.  
  157. (put 'end 'texinfo-format 'texinfo-format-end)
  158. (defun texinfo-format-end ()
  159.   (texinfo-format-begin-end 'texinfo-end))
  160.  
  161. (defun texinfo-format-begin-end (prop)
  162.   (setq texinfo-command-name (intern (texinfo-parse-line-arg)))
  163.   (setq cmd (get texinfo-command-name prop))
  164.   (if cmd (funcall cmd)
  165.     (texinfo-unsupported)))
  166.  
  167. (defun texinfo-parse-line-arg ()
  168.   (goto-char texinfo-command-end)
  169.   (let ((start (point)))
  170.     (cond ((looking-at " ")
  171.        (skip-chars-forward " ")
  172.        (setq start (point))
  173.        (end-of-line)
  174.        (setq texinfo-command-end (1+ (point))))
  175.       ((looking-at "{")
  176.        (setq start (1+ (point)))
  177.        (forward-list 1)
  178.        (setq texinfo-command-end (point))
  179.        (forward-char -1))
  180.       (t
  181.        (error "Invalid texinfo command arg format")))
  182.     (prog1 (buffer-substring start (point))
  183.        (if (eolp) (forward-char 1)))))
  184.  
  185. (defun texinfo-parse-arg-discard ()
  186.   (prog1 (texinfo-parse-line-arg)
  187.      (texinfo-discard-command)))
  188.  
  189. (defun texinfo-discard-command ()
  190.   (delete-region texinfo-command-start texinfo-command-end))
  191.  
  192. (defun texinfo-format-parse-line-args ()
  193.   (let ((start (1- (point)))
  194.     next beg end
  195.     args)
  196.     (skip-chars-forward " ")
  197.     (while (not (eolp))
  198.       (setq beg (point))
  199.       (re-search-forward "[\n,]")
  200.       (setq next (point))
  201.       (if (bolp) (setq next (1- next)))
  202.       (forward-char -1)
  203.       (skip-chars-backward " ")
  204.       (setq end (point))
  205.       (setq args (cons (if (> end beg) (buffer-substring beg end))
  206.                args))
  207.       (goto-char next)
  208.       (skip-chars-forward " "))
  209.     (if (eolp) (forward-char 1))
  210.     (setq texinfo-command-end (point))
  211.     (nreverse args)))
  212.  
  213. (defun texinfo-format-parse-args ()
  214.   (let ((start (1- (point)))
  215.     next beg end
  216.     args)
  217.     (search-forward "{")
  218.     (while (/= (preceding-char) ?\})
  219.       (skip-chars-forward " \t\n")
  220.       (setq beg (point))
  221.       (re-search-forward "[},]")
  222.       (setq next (point))
  223.       (forward-char -1)
  224.       (skip-chars-backward " \t\n")
  225.       (setq end (point))
  226.       (cond ((< beg end)
  227.          (goto-char beg)
  228.          (while (search-forward "\n" end t)
  229.            (replace-match " "))))
  230.       (setq args (cons (if (> end beg) (buffer-substring beg end))
  231.                args))
  232.       (goto-char next))
  233.     (if (eolp) (forward-char 1))
  234.     (setq texinfo-command-end (point))
  235.     (nreverse args)))
  236.  
  237. (put 'setfilename 'texinfo-format 'texinfo-format-setfilename)
  238. (defun texinfo-format-setfilename ()
  239.   (let ((arg (texinfo-parse-arg-discard)))
  240.     (setq texinfo-format-filename (file-name-nondirectory arg))
  241.     (insert "Info file "
  242.